(in-package #:org.shirakumo.fraf.trial.particle-studio)

(defvar *emitter-counter* 1)

(define-shader-entity emitter (alloy:structure cpu-particle-emitter)
  ((sections :initform NIL :accessor sections)
   (paused-p :initform NIL :reader paused-p)
   (burst :initform 10 :accessor burst))
  (:default-initargs
   :particle-rate 20.0
   :texture (assets:// :circle-05)
   :vertex-array (// 'trial 'point)
   :particle-options '(:velocity 5.0 :randomness 0.2)))

(defmethod initialize-instance :around ((emitter emitter) &key)
  (call-next-method)
  (setf (name emitter) (trial::mksym #.*package* 'emitter- (incf *emitter-counter*)))
  (let ((layout (make-instance 'alloy:vertical-linear-layout))
        (focus (make-instance 'alloy:vertical-focus-list)))
    (let ((layout (make-instance 'alloy:grid-layout :col-sizes '(160 T) :row-sizes '(20) :cell-margins (alloy:margins 2)
                                                    :layout-parent layout))
          (row -1))
      (macrolet ((wheel (place title start end &rest args)
                   `(progn
                      (alloy:enter ,title layout :row (incf row) :col 0)
                      (alloy:represent (,place emitter) 'alloy:ranged-wheel
                                       :range '(,start . ,end) ,@args :layout-parent layout :focus-parent focus))))
        (let* ((button (make-instance 'alloy:button* :value "Burst" :focus-parent focus :on-activate
                                      (lambda () (emit emitter T)))))
          (alloy:enter button layout :row (incf row) :col 0)
          (alloy:represent (burst emitter) 'alloy:ranged-wheel :range '(1 . 200) :layout-parent layout :focus-parent focus))
        (wheel particle-rate "Particle Rate" 0 10000)
        (wheel particle-lifespan "Lifespan" 0.0 100.0 :step 0.1)
        (wheel particle-lifespan-randomness "Lifespan Random" 0.0 1.0 :step 0.1)
        (wheel particle-velocity "Velocity" 0.0 100.0)
        (wheel particle-randomness "Randomness" 0.0 1.0 :step 0.1)
        (wheel particle-size "Size" 0.01 10.0 :step 0.1)
        (wheel particle-scaling "Scaling" 0.0 10.0 :step 0.1)
        (wheel particle-rotation "Rotation" 0.0 10.0 :step 0.1)
        (wheel particle-motion-blur "Motion Blur" 0.0 1.0 :step 0.1)
        (alloy:enter "Display Mode" layout :row (incf row) :col 0)
        (alloy:represent (particle-mode emitter) 'alloy:combo-set
                         :value-set '(:quad :billboard) :layout-parent layout :focus-parent focus)
        (alloy:enter "Texture" layout :row (incf row) :col 0)
        (alloy:represent (texture emitter) T :layout-parent layout :focus-parent focus
                         :filter (lambda (x) (and (typep (generator x) 'image)
                                                  (member (getf (trial::generation-arguments (generator x)) :target)
                                                          '(NIL :texture-2d)))))
        (alloy:enter "Texture Flip" layout :row (incf row) :col 0)
        (alloy:represent (particle-flip emitter) 'alloy:combo-set
                         :value-set '(NIL :x :y T) :layout-parent layout :focus-parent focus)
        (alloy:enter "Color" layout :row (incf row) :col 0)
        (let* ((color (particle-color emitter))
               (c (alloy:represent color T :layout-parent layout :focus-parent focus)))
          (alloy:on alloy:value (v c)
                    (setf (particle-color emitter) color)))
        (alloy:enter "Color Multiplier" layout :row (incf row) :col 0)
        (let* ((color (particle-color-multiplier emitter))
               (c (alloy:represent color T :layout-parent layout :focus-parent focus)))
          (alloy:on alloy:value (v c)
            (setf (particle-color-multiplier emitter) color)))
        (alloy:enter "Blend Mode" layout :row (incf row) :col 0)
        (alloy:represent (blend-mode emitter) 'alloy:combo-set
                         :value-set '(:add :normal :invert :darken :multiply :screen) :layout-parent layout :focus-parent focus)
        (alloy:enter "Emitter Shape" layout :row (incf row) :col 0)
        (let* ((shape :point)
               (c (alloy:represent shape 'alloy:combo-set
                                   :value-set '(:square :disc :sphere :cube :point) :layout-parent layout :focus-parent focus)))
          (alloy:on alloy:value (v c)
                    (setf (vertex-array emitter)
                          (ecase v
                            (:square (// 'trial 'unit-square))
                            (:disc (// 'trial 'unit-disc))
                            (:sphere (// 'trial 'unit-sphere))
                            (:cube (// 'trial 'unit-cube))
                            (:point (// 'trial 'point))))))
        (alloy:enter "Force Fields" layout :row (incf row) :col 0)
        (make-instance 'alloy:button* :value "Add" :focus-parent focus :layout-parent layout :on-activate
                       (lambda () (make-instance 'force-field :emitter emitter)))))
    (let ((sections (make-instance 'alloy:section-list :layout-parent layout :focus-parent focus))
          (fields (particle-force-fields emitter)))
      (setf (sections emitter) sections)
      (loop for i from 0 below (trial::particle-force-field-count fields)
            do (make-instance 'force-field :emitter emitter :i i)))
    (alloy:finish-structure emitter layout focus)
    ;; Register
    (enter-and-load emitter (scene +main+) +main+)))

(defmethod enter :after ((emitter emitter) (scene scene))
  (alloy:enter emitter (sections (trial-alloy:find-panel 'base-panel))
               :label (string-capitalize (name emitter))))

(defmethod leave :after ((emitter emitter) (container container))
  (alloy:leave emitter (sections (trial-alloy:find-panel 'base-panel))))

(defmethod serialize ((emitter cpu-particle-emitter))
  (flet ((res (res)
           `(// ',(name (pool (generator res)))
                ',(name (generator res))
                ',(name res))))
    (list :max-particles (max-particles emitter)
          :vertex-array (res (vertex-array emitter))
          :texture (res (texture emitter))
          :motion-blur (particle-motion-blur emitter)
          :color-multiplier (particle-color-multiplier emitter)
          :blend-mode (blend-mode emitter)
          :offset (particle-offset emitter)
          :particle-rate (particle-rate emitter)
          :particle-options `(list ,@(remf* (particle-options emitter) :texture))
          :particle-force-fields (particle-force-field-list emitter))))

(defmethod (setf paused-p) (value (emitter emitter))
  (when (or (and value (not (paused-p emitter)))
            (and (not value) (paused-p emitter)))
    (if value
        (shiftf (slot-value emitter 'paused-p) (particle-rate emitter) 0)
        (shiftf (particle-rate emitter) (slot-value emitter 'paused-p) NIL))))

(defmethod emit ((emitter emitter) (count (eql T)) &rest args)
  (apply #'emit emitter (burst emitter) args))
